home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / tvtool2.zip / TVSCROLL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-20  |  12KB  |  113 lines
  1. {*
  2. *
  3. *   Copyright (c) 1992,93 by Richard W. Hansen
  4. *
  5. *   This source code will compile.
  6. *   Full source code available to registered users.
  7. *
  8. *}
  9. (* This file was mangled by Mangler 1.10 (c) Copyright 1993 by Berend de Boer *)
  10.  UNIT TVSCROLL ;{$B+} {$X+} {$V-} {$I TVDEFS.INC} INTERFACE USES TVCONST , TVVIEWS , OBJECTS , DIALOGS , DRIVERS ,
  11. VIEWS ;CONST GFSCROLLXY =$80 ;SCVSCROLL =OFVSCROLLBAR ;SCHSCROLL =OFHSCROLLBAR ;CSCROLLINPUTLINE =#1#6#7#1;
  12. TYPE PBXSCROLLGROUP =^TBXSCROLLGROUP ;TBXSCROLLGROUP =OBJECT (TGROUP)VSCROLLBAR :PSCROLLBAR ;HSCROLLBAR :PSCROLLBAR ;
  13. OLDPOS :TPOINT ;AUTOPOS :BOOLEAN ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;AHSCROLLBAR :PSCROLLBAR ;
  14. AVSCROLLBAR :PSCROLLBAR );CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;
  15. PROCEDURE STORE (VAR S :TSTREAM );END ;PBXSCROLLDIALOG =^TBXSCROLLDIALOG ;
  16. TBXSCROLLDIALOG =OBJECT (TDIALOG)LIMIT :TPOINT ;VSCROLLBAR :PSCROLLBAR ;HSCROLLBAR :PSCROLLBAR ;
  17. INTERIOR :PBXSCROLLGROUP ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;ATITLE :STRING ;OFFLAG :WORD );CONSTRUCTOR LOAD
  18. (VAR S :TSTREAM );PROCEDURE AUTOPOSITION (ENABLE :BOOLEAN );FUNCTION INITBACKGROUND :PVIEW ;VIRTUAL;
  19. PROCEDURE INSERTTOSCROLL (P :PVIEW );PROCEDURE SETLIMIT (X ,Y:INTEGER );PROCEDURE STORE (VAR S :TSTREAM );END ;
  20. PBXSCROLLVIEW =^TBXSCROLLVIEW ;TBXSCROLLVIEW =OBJECT (TVIEW)CONSTRUCTOR INIT (VAR BOUNDS :TRECT );PROCEDURE HANDLEEVENT
  21. (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE SETSTATE (ASTATE :WORD ;ENABLE :BOOLEAN );VIRTUAL;END ;
  22. PBXSCROLLINPUTLINE =^TBXSCROLLINPUTLINE ;TBXSCROLLINPUTLINE =OBJECT (TINPUTLINE)FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;
  23. END ;PBXSCROLLWINDOW =^TBXSCROLLWINDOW ;TBXSCROLLWINDOW =OBJECT (TBXWINDOW)LIMIT :TPOINT ;VSCROLLBAR :PSCROLLBAR ;
  24. HSCROLLBAR :PSCROLLBAR ;INTERIOR :PBXSCROLLGROUP ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;ATITLE :STRING ;ANUMBER :WORD ;
  25. OFFLAG :WORD );CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE AUTOPOSITION (ENABLE :BOOLEAN );PROCEDURE CHANGEBOUNDS
  26. (VAR BOUNDS :TRECT );VIRTUAL;FUNCTION INITBACKGROUND :PVIEW ;VIRTUAL;PROCEDURE INSERTTOSCROLL (P :PVIEW );
  27. PROCEDURE SETLIMIT (X ,Y:INTEGER );PROCEDURE STORE (VAR S :TSTREAM );END ;PROCEDURE REGISTERTVSCROLL ;
  28. CONST RBXSCROLLGROUP :TSTREAMREC =(OBJTYPE :5350 ;VMTLINK :OFS (TYPEOF (TBXSCROLLGROUP )^);LOAD :@ TBXSCROLLGROUP .
  29. LOAD ;STORE :@ TBXSCROLLGROUP . STORE );CONST RBXSCROLLDIALOG :TSTREAMREC =(OBJTYPE :5351 ;
  30. VMTLINK :OFS (TYPEOF (TBXSCROLLDIALOG )^);LOAD :@ TBXSCROLLDIALOG . LOAD ;STORE :@ TBXSCROLLDIALOG . STORE );
  31. CONST RBXSCROLLINPUTLINE :TSTREAMREC =(OBJTYPE :5352 ;VMTLINK :OFS (TYPEOF (TBXSCROLLINPUTLINE )^);LOAD :@
  32. TBXSCROLLINPUTLINE . LOAD ;STORE :@ TBXSCROLLINPUTLINE . STORE );CONST RBXSCROLLWINDOW :TSTREAMREC =(OBJTYPE :5353 ;
  33. VMTLINK :OFS (TYPEOF (TBXSCROLLWINDOW )^);LOAD :@ TBXSCROLLWINDOW . LOAD ;STORE :@ TBXSCROLLWINDOW . STORE );
  34. IMPLEMENTATION CONSTRUCTOR TBXSCROLLGROUP.INIT (VAR BOUNDS:TRECT;AHSCROLLBAR:PSCROLLBAR;AVSCROLLBAR:PSCROLLBAR);
  35. BEGIN INHERITED INIT(BOUNDS );HSCROLLBAR := AHSCROLLBAR ;VSCROLLBAR := AVSCROLLBAR ;GROWMODE := GROWMODE OR GFGROWHIX OR
  36. GFGROWHIY ;AUTOPOS := TRUE ;END ;CONSTRUCTOR TBXSCROLLGROUP.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );GETPEERVIEWPTR
  37. (S , HSCROLLBAR );GETPEERVIEWPTR (S , VSCROLLBAR );S.READ (OLDPOS , SIZEOF (TPOINT ));S.READ (AUTOPOS , SIZEOF (BOOLEAN
  38. ));END ;PROCEDURE TBXSCROLLGROUP.HANDLEEVENT (VAR EVENT:TEVENT);VAR O1OllII1lOI0:TEVENT;O1I10Ol1:INTEGER;
  39. O1I1Il0I:INTEGER;OI1I1O1lll10:TPOINT;PROCEDURE OIlI0lO101O (OO10:PVIEW);FAR ;BEGIN IF (OO10 ^. GROWMODE AND GFSCROLLXY <>
  40. 0 )THEN BEGIN OO10 ^. ORIGIN.X := OO10 ^. ORIGIN.X + O1I10Ol1 ;OO10 ^. ORIGIN.Y := OO10 ^. ORIGIN.Y + O1I1Il0I ;END ;
  41. END ;PROCEDURE O1OlOO0110 ;BEGIN IF (CURRENT <> NIL )THEN BEGIN O1I10Ol1 := 0 ;O1I1Il0I := 0 ;IF (HSCROLLBAR <> NIL )THEN
  42. BEGIN IF (CURRENT ^. ORIGIN.X < 0 )THEN HSCROLLBAR ^. VALUE := HSCROLLBAR ^. VALUE + CURRENT ^. ORIGIN.X ELSE IF (CURRENT
  43. ^. ORIGIN.X + CURRENT ^. SIZE.X > SIZE.X )THEN HSCROLLBAR ^. VALUE := HSCROLLBAR ^. VALUE + (CURRENT ^. ORIGIN.X +
  44. CURRENT ^. SIZE.X - SIZE.X );O1I10Ol1 := OLDPOS.X - HSCROLLBAR ^. VALUE ;IF (O1I10Ol1 <> 0 )THEN BEGIN OLDPOS.X :=
  45. HSCROLLBAR ^. VALUE ;HSCROLLBAR ^. DRAWVIEW ;END ;END ;IF (VSCROLLBAR <> NIL )THEN BEGIN IF (CURRENT ^. ORIGIN.Y < 0
  46. )THEN VSCROLLBAR ^. VALUE := VSCROLLBAR ^. VALUE + CURRENT ^. ORIGIN.Y ELSE IF (CURRENT ^. ORIGIN.Y + CURRENT ^. SIZE.Y >
  47. SIZE.Y )THEN VSCROLLBAR ^. VALUE := VSCROLLBAR ^. VALUE + (CURRENT ^. ORIGIN.Y + CURRENT ^. SIZE.Y - SIZE.Y );O1I1Il0I :=
  48. OLDPOS.Y - VSCROLLBAR ^. VALUE ;IF (O1I1Il0I <> 0 )THEN BEGIN OLDPOS.Y := VSCROLLBAR ^. VALUE ;VSCROLLBAR ^. DRAWVIEW ;
  49. END ;END ;END ;END ;BEGIN IF (EVENT.WHAT =EVBROADCAST )THEN CASE EVENT.COMMAND  OF CMSCROLLBARCHANGED :IF (EVENT.INFOPTR
  50. <> NIL )THEN IF (HSCROLLBAR <> NIL )OR (VSCROLLBAR <> NIL )THEN BEGIN O1I10Ol1 := 0 ;O1I1Il0I := 0 ;IF (HSCROLLBAR
  51. =EVENT.INFOPTR )THEN BEGIN O1I10Ol1 := OLDPOS.X - HSCROLLBAR ^. VALUE ;OLDPOS.X := HSCROLLBAR ^. VALUE ;END ELSE IF
  52. (VSCROLLBAR =EVENT.INFOPTR )THEN BEGIN O1I1Il0I := OLDPOS.Y - VSCROLLBAR ^. VALUE ;OLDPOS.Y := VSCROLLBAR ^. VALUE ;
  53. END ;IF (O1I10Ol1 <> 0 )OR (O1I1Il0I <> 0 )THEN BEGIN FOREACH (@ OIlI0lO101O );REDRAW ;IF (CURRENT <> NIL )THEN IF
  54. (CURRENT ^. STATE AND SFCURSORVIS <> 0 )THEN CURRENT ^. SETCURSOR (CURRENT ^. CURSOR.X , CURRENT ^. CURSOR.Y );END ;EXIT
  55. ;END ;END ELSE IF (EVENT.WHAT =EVKEYDOWN )THEN CASE EVENT.KEYCODE  OF KBTAB :BEGIN FOCUSNEXT (FALSE );IF AUTOPOS THEN
  56. BEGIN O1OlOO0110 ;IF (O1I10Ol1 <> 0 )OR (O1I1Il0I <> 0 )THEN BEGIN FOREACH (@ OIlI0lO101O );REDRAW ;END ;END ;CLEAREVENT
  57. (EVENT );EXIT ;END ;KBSHIFTTAB :BEGIN FOCUSNEXT (TRUE );IF AUTOPOS THEN BEGIN O1OlOO0110 ;IF (O1I10Ol1 <> 0 )OR (O1I1Il0I
  58. <> 0 )THEN BEGIN FOREACH (@ OIlI0lO101O );REDRAW ;END ;END ;CLEAREVENT (EVENT );EXIT ;END ;END ;O1OllII1lOI0 := EVENT ;
  59. INHERITED HANDLEEVENT(EVENT );IF (O1OllII1lOI0.WHAT AND EVMOUSEDOWN <> 0 )AND AUTOPOS THEN BEGIN IF (CURRENT <> NIL )AND
  60. CURRENT ^. MOUSEINVIEW (O1OllII1lOI0.WHERE )THEN BEGIN O1OlOO0110 ;IF (O1I10Ol1 <> 0 )OR (O1I1Il0I <> 0 )THEN
  61. BEGIN FOREACH (@ OIlI0lO101O );REDRAW ;END ;END ;END ;END ;PROCEDURE TBXSCROLLGROUP.STORE (VAR S:TSTREAM);
  62. BEGIN INHERITED STORE(S );PUTPEERVIEWPTR (S , HSCROLLBAR );PUTPEERVIEWPTR (S , VSCROLLBAR );S.WRITE (OLDPOS , SIZEOF
  63. (TPOINT ));S.WRITE (AUTOPOS , SIZEOF (BOOLEAN ));END ;CONSTRUCTOR TBXSCROLLDIALOG.INIT (VAR BOUNDS:TRECT;ATITLE:STRING ;
  64. OFFLAG:WORD);VAR OO1I:TRECT;OO10:PVIEW;BEGIN INHERITED INIT(BOUNDS , ATITLE );IF (OFFLAG AND OFHSCROLLBAR <> 0 )THEN
  65. BEGIN HSCROLLBAR := STANDARDSCROLLBAR (SBHORIZONTAL OR SBHANDLEKEYBOARD );INSERT (HSCROLLBAR );END ;IF (OFFLAG AND
  66. OFVSCROLLBAR <> 0 )THEN BEGIN VSCROLLBAR := STANDARDSCROLLBAR (SBVERTICAL OR SBHANDLEKEYBOARD );INSERT (VSCROLLBAR );
  67. END ;GETEXTENT (OO1I );OO1I.GROW (- 1 , - 1 );INTERIOR := NEW (PBXSCROLLGROUP , INIT (OO1I , HSCROLLBAR , VSCROLLBAR ));
  68. INSERT (INTERIOR );INTERIOR ^. INSERT (INITBACKGROUND );END ;CONSTRUCTOR TBXSCROLLDIALOG.LOAD (VAR S:TSTREAM);
  69. BEGIN INHERITED LOAD(S );S.READ (LIMIT , SIZEOF (TPOINT ));GETSUBVIEWPTR (S , VSCROLLBAR );GETSUBVIEWPTR (S , HSCROLLBAR
  70. );GETSUBVIEWPTR (S , INTERIOR );END ;PROCEDURE TBXSCROLLDIALOG.AUTOPOSITION (ENABLE:BOOLEAN);BEGIN INTERIOR ^. AUTOPOS :=
  71. ENABLE ;END ;FUNCTION TBXSCROLLDIALOG.INITBACKGROUND :PVIEW ;VAR OO1I:TRECT;OO10:PVIEW;BEGIN INTERIOR ^. GETEXTENT (OO1I
  72. );OO10 := NEW (PVIEW , INIT (OO1I ));OO10 ^. SETSTATE (SFDISABLED , TRUE );OO10 ^. OPTIONS := OO10 ^. OPTIONS AND NOT
  73. OFSELECTABLE ;INITBACKGROUND := OO10 ;END ;PROCEDURE TBXSCROLLDIALOG.INSERTTOSCROLL (P:PVIEW);BEGIN INTERIOR ^. INSERT (P
  74. );P ^. GROWMODE := P ^. GROWMODE OR GFSCROLLXY ;END ;PROCEDURE TBXSCROLLDIALOG.SETLIMIT (X,Y:INTEGER);BEGIN LIMIT.X := X
  75. ;LIMIT.Y := Y ;IF (HSCROLLBAR <> NIL )THEN HSCROLLBAR ^. SETPARAMS (HSCROLLBAR ^. VALUE , 0 , X - SIZE.X , SIZE.X - 1 , 1
  76. );IF (VSCROLLBAR <> NIL )THEN VSCROLLBAR ^. SETPARAMS (VSCROLLBAR ^. VALUE , 0 , Y - SIZE.Y , SIZE.Y - 1 , 1 );END ;
  77. PROCEDURE TBXSCROLLDIALOG.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (LIMIT , SIZEOF (TPOINT ));
  78. PUTSUBVIEWPTR (S , VSCROLLBAR );PUTSUBVIEWPTR (S , HSCROLLBAR );PUTSUBVIEWPTR (S , INTERIOR );END ;
  79. CONSTRUCTOR TBXSCROLLVIEW.INIT (VAR BOUNDS:TRECT);BEGIN INHERITED INIT(BOUNDS );OPTIONS := OPTIONS OR OFSELECTABLE ;
  80. DRAGMODE := DMDRAGMOVE OR DMDRAGGROW ;EVENTMASK := EVENTMASK OR EVBROADCAST ;END ;PROCEDURE TBXSCROLLVIEW.HANDLEEVENT
  81. (VAR EVENT:TEVENT);PROCEDURE O10O0101OIIII (OI0ll01lOl0l:BYTE);VAR O10OOI0I1l0IO:TRECT;OIO0O1OlIlO,OIll00l10I0:TPOINT;
  82. BEGIN IF (DRAGMODE AND OI0ll01lOl0l <> 0 )THEN BEGIN OWNER ^. GETEXTENT (O10OOI0I1l0IO );SIZELIMITS (OIO0O1OlIlO ,
  83. OIll00l10I0 );OI0ll01lOl0l := OI0ll01lOl0l OR DRAGMODE AND NOT DMDRAGMOVE AND NOT DMDRAGGROW ;DRAGVIEW (EVENT ,
  84. OI0ll01lOl0l , O10OOI0I1l0IO , OIO0O1OlIlO , OIll00l10I0 );CLEAREVENT (EVENT );END ;END ;VAR OI1I1O1lll10:TPOINT;
  85. BEGIN INHERITED HANDLEEVENT(EVENT );IF (EVENT.WHAT =EVCOMMAND )THEN BEGIN CASE EVENT.COMMAND  OF CMDRAGVIEW
  86. :O10O0101OIIII (DMDRAGMOVE OR DMDRAGGROW );END ;END ELSE IF (EVENT.WHAT =EVBROADCAST )THEN BEGIN CASE EVENT.COMMAND
  87.  OF CMRECEIVEDFOCUS , CMRELEASEDFOCUS :DRAWVIEW ;END ;END ELSE IF (EVENT.WHAT =EVMOUSEDOWN )THEN BEGIN MAKELOCAL
  88. (EVENT.WHERE , OI1I1O1lll10 );IF (OI1I1O1lll10.Y =0 )AND (OI1I1O1lll10.X < SIZE.X - 1 )THEN O10O0101OIIII (DMDRAGMOVE
  89. )ELSE IF (OI1I1O1lll10.X >= SIZE.X - 1 )AND (OI1I1O1lll10.Y >= SIZE.Y - 1 )THEN O10O0101OIIII (DMDRAGGROW );END ;END ;
  90. PROCEDURE TBXSCROLLVIEW.SETSTATE (ASTATE:WORD;ENABLE:BOOLEAN);BEGIN INHERITED SETSTATE(ASTATE , ENABLE );IF (ASTATE
  91. =SFSELECTED )THEN SETSTATE (SFACTIVE , ENABLE )ELSE IF (ASTATE AND (SFDRAGGING OR SFACTIVE )<> 0 )THEN DRAWVIEW ;END ;
  92. FUNCTION TBXSCROLLINPUTLINE.GETPALETTE :PPALETTE ;CONST OO10:STRING [ LENGTH(CSCROLLINPUTLINE)] =CSCROLLINPUTLINE;
  93. BEGIN GETPALETTE := @ OO10 ;END ;CONSTRUCTOR TBXSCROLLWINDOW.INIT (VAR BOUNDS:TRECT;ATITLE:STRING ;ANUMBER:WORD;
  94. OFFLAG:WORD);VAR OO1I:TRECT;BEGIN INHERITED INIT(BOUNDS , ATITLE , ANUMBER );IF (OFFLAG AND OFHSCROLLBAR <> 0 )THEN
  95. BEGIN HSCROLLBAR := STANDARDSCROLLBAR (SBHORIZONTAL OR SBHANDLEKEYBOARD );INSERT (HSCROLLBAR );END ;IF (OFFLAG AND
  96. OFVSCROLLBAR <> 0 )THEN BEGIN VSCROLLBAR := STANDARDSCROLLBAR (SBVERTICAL OR SBHANDLEKEYBOARD );INSERT (VSCROLLBAR );
  97. END ;GETEXTENT (OO1I );OO1I.GROW (- 1 , - 1 );INTERIOR := NEW (PBXSCROLLGROUP , INIT (OO1I , HSCROLLBAR , VSCROLLBAR ));
  98. INSERT (INTERIOR );INTERIOR ^. INSERT (INITBACKGROUND );END ;CONSTRUCTOR TBXSCROLLWINDOW.LOAD (VAR S:TSTREAM);
  99. BEGIN INHERITED LOAD(S );GETSUBVIEWPTR (S , INTERIOR );END ;PROCEDURE TBXSCROLLWINDOW.AUTOPOSITION (ENABLE:BOOLEAN);
  100. BEGIN INTERIOR ^. AUTOPOS := ENABLE ;END ;PROCEDURE TBXSCROLLWINDOW.CHANGEBOUNDS (VAR BOUNDS:TRECT);
  101. BEGIN INHERITED CHANGEBOUNDS(BOUNDS );IF (HSCROLLBAR <> NIL )THEN HSCROLLBAR ^. SETPARAMS (HSCROLLBAR ^. VALUE , 0 ,
  102. LIMIT.X - SIZE.X + 2 , SIZE.X - 1 , 1 );IF (VSCROLLBAR <> NIL )THEN VSCROLLBAR ^. SETPARAMS (VSCROLLBAR ^. VALUE , 0 ,
  103. LIMIT.Y - SIZE.Y + 2 , SIZE.Y - 1 , 1 );END ;FUNCTION TBXSCROLLWINDOW.INITBACKGROUND :PVIEW ;VAR OO1I:TRECT;OO10:PVIEW;
  104. BEGIN INTERIOR ^. GETEXTENT (OO1I );OO10 := NEW (PVIEW , INIT (OO1I ));OO10 ^. SETSTATE (SFDISABLED , TRUE );OO10 ^.
  105. OPTIONS := OO10 ^. OPTIONS AND NOT OFSELECTABLE ;INITBACKGROUND := OO10 ;END ;PROCEDURE TBXSCROLLWINDOW.INSERTTOSCROLL
  106. (P:PVIEW);BEGIN INTERIOR ^. INSERT (P );P ^. GROWMODE := P ^. GROWMODE OR GFSCROLLXY ;END ;
  107. PROCEDURE TBXSCROLLWINDOW.SETLIMIT (X,Y:INTEGER);BEGIN LIMIT.X := X ;LIMIT.Y := Y ;IF (HSCROLLBAR <> NIL )THEN HSCROLLBAR
  108. ^. SETPARAMS (HSCROLLBAR ^. VALUE , 0 , X - SIZE.X , SIZE.X - 1 , 1 );IF (VSCROLLBAR <> NIL )THEN VSCROLLBAR ^. SETPARAMS
  109. (VSCROLLBAR ^. VALUE , 0 , Y - SIZE.Y , SIZE.Y - 1 , 1 );END ;PROCEDURE TBXSCROLLWINDOW.STORE (VAR S:TSTREAM);
  110. BEGIN INHERITED STORE(S );PUTSUBVIEWPTR (S , INTERIOR );END ;PROCEDURE REGISTERTVSCROLL ;BEGIN REGISTERTYPE
  111. (RBXSCROLLGROUP );REGISTERTYPE (RBXSCROLLDIALOG );REGISTERTYPE (RBXSCROLLINPUTLINE );REGISTERTYPE (RBXSCROLLWINDOW );
  112. END ;END .
  113.